{--
    Classes and Instances to convert values to 'String's ('show') and 'String's to values
    ("read").

    There are a few differences to Haskell, notably

    - "Read" cannot be derived and supports only simple types
-}

protected package frege.prelude.PreludeText where

import frege.prelude.PreludeBase
import frege.prelude.PreludeList(dropWhile)
import Java.Lang (StringBuilder, Appendable, System, Byte, Short)
import frege.prelude.PreludeList (ListView, ++, map, intersperse, null, foldr)
import frege.prelude.PreludeMonad (mapM_, foldM, >>, >>=)
import frege.java.util.Regex
import frege.prelude.Maybe
import frege.control.Semigroupoid


--- Haskell compatibility
type ShowS = String -> String
--- Haskell compatibility
type ReadS a = String -> [(a, String)]

{--
 * Class 'Show' provides operations to convert values to 'String's.

 * This class can be derived for all algebraic data types whose constituents
 * are themselves instances of 'Show'.
 -}
class Show show where
    --- Computes the string representation of a value.
    --- Every instance must implement 'show'.
    show    :: show -> String
    {--
     * 'showsub' is used for 'show'ing elements of a value of an algebraic data type
     * in derived instances of 'Show'.
     *
     * The generated code in derived instances for types that are not
     * enumerations is
     * > showsub x = "(" ++ show x ++ ")"
     * so that values are enclosed in parentheses.
     * Certain types like records, lists, tuples and many primitive types do not need
     * extra parentheses, and thus 'showsub' is the same as 'show', which is also the
     * default implementation.
     *
     * In short,
     * - in derived instances, 'showsub' will do the right thing.
     * - in all other instances, 'showsub' will do the same as 'show' if not
     *   implemented differently.
     *
     * Example:
     * > derive Show ( Maybe b)
     * implements the following:
     * > show Nothing = "Nothing"
     * > show (Just x) = "Just " ++ x.showsub
     * > showsub x = "(" ++ show x ++ ")"
     * so that
     * > show (Just (Just 42)) == "Just (Just 42)"
     *
     -}
    showsub :: show -> String
    {--
     'display' computes an alternate string representation of a value and is
     used in the 'Char' and 'String' instances of 'Show' to produce an unquoted string.

     The default implementation is to do the same as 'show'.
     -}
    display   :: show -> String
    --- Haskell compatibility
    showsPrec :: Int -> show -> String -> String
    --- Haskell compatibility
    showList  :: [show] -> String -> String
    {--
        'showChars' addresses the problem of 'show'ing infinite values.
        Because 'show' has type 'String' and 'String' is atomic, this would
        try to create a string with infinite length, and hence is doomed to fail.
        
        The default definition is
        
        > showChars = String.toList . show
        
        This is ok for all finite values. But instances for recursive types
        should implement it in a way that produces a lazy list of characters.
        
        Here is an example for the list instance:
        
        > showChars [] = ['[', ']']
        > showChars xs = '[' : ( tail [ c | x <- xs, c <- ',' : showChars x ] ++ [']'] )
        
    -}
    showChars :: show -> [Char]

    showsPrec _ x s = show x  ++ s
    showList as s   = "[" ++ joined ", " (map show as) ++ "]" ++ s
    showsub x = show x
    display d = show d
    showChars = String.toList . show

instance Show Bool where
    show b = if b then "true" else "false"

instance Show Char where
    --- reconstructs a Java char literal from a character, i.e.
    --- > show 'a' = "'a'"
    pure native show frege.runtime.Runtime.quoteChr :: Char -> String
    --- construct a string that consists of just this character
    display c = ctos c
    --- the string created from the characters
    showList cs s = show (foldr (++) s (map display cs))

instance Show Integer where
    --- the 'String' representation of the 'Integer' argument, uses @BigInteger.toString@
    pure native show   toString :: Integer -> String

instance Show Int where
    --- the 'String' representation of the 'Int' argument, uses @java.lang.String.valueOf@
    pure native show   java.lang.String.valueOf    :: Int -> String

instance Show Byte where
    show b = "0x%02x".format b.unsigned

instance Show Short where
    show = show . _.unsigned

instance Show Long where
    --- the 'String' representation of the 'Long' argument, uses @java.lang.Long.toString@
    pure native show       java.lang.Long.toString     :: Long -> String

instance Show Float where
    pure native show java.lang.Float.toString :: Float -> String

instance Show Double where
    pure native show java.lang.Double.toString :: Double -> String

instance Show String where
    --- reconstructs a Java string literal from a string, i.e.
    --- > show "abc" = "\"abc\""
    pure native show frege.runtime.Runtime.quoteStr :: String -> String
    display s = s

instance Show a => Show  [a] where
    show lst = showList lst ""     --  "[" ++ joined ", " (map Show.show lst) ++ "]"
    -- showsub = show
    -- display = show

    showChars [] = ['[', ']']
    showChars xs = '[' : ( tail [ c | x <- xs, c <- ',' : showChars x ] ++ [']'] )

instance Show PreludeBase.Throwable where
    {-- creates a string representation of a Java exception, consisting of
       the class name and the message, like
       > "java.lang.ArithmeticException: division by zero"
    -}
    show jx = jx.caught ++ ": " ++ jx.getMessage

-- some derived Show instances for standard types.

derive Show     ()
derive Show     (a,b)
derive Show     (a,b,c)
derive Show     Ordering
derive Show     (Maybe a)
derive Show     (Either a b)
instance Show Regex where
    show r = r.pattern

-- other utility functions

{--
  @joined sep xs@ concatenates all strings in /xs/,
  and inserts /sep/ between any two elements of /xs/.

  If /xs/ is empty, the result is an empty string. If /sep/ is an empty string,
  then the result is just the concatenation of the strings in /xs/.

  Example:
  > joined ", " ["aaa", "bbb", "ccc"] == "aaa, bbb, ccc"
 -}
-- joined :: String -> Maybe String -> String
joined xx xs | null xs   = ""
             | otherwise = ST.run (build (intersperse xx xs)) where
    build :: forall s . [String] -> ST s String
    build xs = do
        sb <- StringBuilder.new ""
        mapM_ sb.append xs
        sb.toString

{--
    convert a list of characters to a string
    > packed ['a', 'b', 'c' ] == "abc"
    -}
packed :: [Char] -> String
packed cs | null cs = ""
          | otherwise = ST.run (packit cs) where
    packit :: [Char] -> ST s String
    packit cs = do
        sb <- StringBuilder.new ""
        mapM_ sb.append cs
        sb.toString                    

--- Haskell compatibility
shows :: (Show a) => a -> String -> String
shows = showsPrec 0

--- Haskell compatibility
showChar :: Char -> String -> String
showChar = (++) . ctos

--- Haskell compatibility
showString :: String -> String -> String
showString = (++)

--- Haskell compatibility
showParen :: Bool -> (String -> String) -> String -> String
showParen b p s = (if b then showChar '(' • p • showChar ')'  else p) s

--- Preliminary substitute for Read
class Read a where
    read :: String → a
    
instance Read Int where
    read s = case s.int of
        Right n → n
        Left _  → error ("Cannot parse " ++ show s ++ " to Int")

--- splits a 'String' on end-of-line  and returns a list of 'String's
--- The last line may or may not be terminated by newline.
--- End-of-line is signaled by a number of carriage returns followed by a new line.
--- This should work for UNIX and Windows.
lines "" = []   -- without that we would get [""]
lines s  = ´\r*\n´.splitted s

--- The line separator suitable for the platform the program is running on.
lineSeparator = fromMaybe "\n" (System.getProperty "line.separator")

--- 'unlines' is an inverse operation to 'lines'.
---  It joins lines, after appending a terminating newline to each.
unlines xs 
    | null xs   = ""
    | otherwise = joined lineSeparator xs ++ lineSeparator

--- strip trailing spaces, tabs, newline and carriage return characters from a string
chomp :: String -> String
chomp s = s.replaceFirst ´( |\t|\r|\n)*$´ ""

{-- 
    splits a 'String' on non empty sequences of spaces  and returns a list of 'String's

    Since this uses @java.util.Regex.split@ the result will start with an empty string if the
    argument starts with spaces. This is a difference to 'words', which, according to the
    Haskell standard, does not include the empty string.
-} 
splittedWords "" = []    -- without that we would get [""]
splittedWords s  =   ´\s+´.splitted s

--- splits a 'String' on non empty sequences of spaces  and returns a list of non-empty 'String's
words = dropWhile null . splittedWords

--- 'unwords' is an inverse operation to 'words'.
--- It joins words with separating spaces.
unwords = joined " "
